<%
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 版权所有（C）2018 viviworld
' 本程序为自由软件，在自由软件联盟发布的GNU通用公共许可协议的约束下，你可以对其进行再发布及修改。协议版本为第三版或（随你）更新的版本。
' 我们希望发布的这款程序有用，但不保证，甚至不保证它有经济价值和适合特定用途。详情参见GNU通用公共许可协议。
' 你理当已收到一份GNU通用公共许可协议的副本，如果没有，请查阅<http://www.gnu.org/licenses/>

' QQ: 548841861 （木鱼）
' Email： 365zph@gmail.com
' 项目地址：https://gitee.com/banrenma/RefineCMS
' 协议地址： https://gitee.com/banrenma/RefineCMS/blob/master/LICENSE
' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

%>
<% If Not DIRECT_VISIT Then Response.Write "No direct script access allowed" : Response.End%>
<%

Sub rfExit(msg)
    Response.Write msg
    Response.End
End Sub

Sub rfPrintTwoDimensionalArray(arr)
    If IsNull(arr) Then
        rfExit "(empty)"
    Else
        Dim i, j, result
        For i=LBound(arr, 2) to UBound(arr, 2)
            result = result & "Row Index: " & i & "<br />"
            For j=LBound(arr, 1) to UBound(arr, 1)
                result = result & "[" & j & "][" & i & "]" & ": " & arr(j, i) & "<br />"
            Next
            result = result & "------------------------------<br />"
        Next
        rfExit result
    End If
End Sub

Function fmtFileSize(val_bytes)
    If val_bytes > 1000000000 Then
        fmtFileSize = Round(val_bytes / 1073741824, 2) & " GB"
    ElseIf val_bytes > 1000000 Then
        fmtFileSize = Round(val_bytes / 1048576, 2) & " MB"
    ElseIf val_bytes > 1000 Then
        fmtFileSize = Round(val_bytes / 1024, 2) & " KB"
    Else
        fmtFileSize = val_bytes & " Bytes"
    End If
End Function

Function fmtReady(status)
    If status Then
        fmtReady = "<span class=""glyphicon glyphicon-ok"" aria-hidden=""true""></span>"
    Else
        fmtReady = "<span class=""glyphicon glyphicon-remove"" aria-hidden=""true""></span>"
    End If
End Function

Function fmtObjectToString(val)
    If IsObject(val) Then
        fmtObjectToString = "[Object]"
    ElseIf IsArray(val) Then
        fmtObjectToString = "[Array]"
    Else
        fmtObjectToString = Server.HTMLEncode(val)
    End If
End Function

Sub rfTransferLogin
    ' Response.Redirect("?" & QP("rf_action") & "=backend&module=login")
    ' 避免使用 Response.Redirect 而造成二次请求服务器，加快访问速度。
    Dim  message
    %>
    <!-- #include file="../templates/backend/admin/login.asp" -->
    <%
    Response.End
End Sub

Sub rfAccessAuthority
    Dim module
    module = Request.QueryString("module")
    If module="login" Or module="logout" Then
        Exit Sub
    End If

    If Session("rf_user_username") = "" Then
        rfTransferLogin
    End If
    Dim arrAdmin
    arrAdmin = Array("user.list", "user.info")
    If rfInArray(module, arrAdmin) And Session("rf_user_role") <>1 Then
        rfShowErrorAuto "[libs/helper.asp][Sub rfAccessAuthority(module)]", T("rf_lang_access_authority_deny")
    End If
End Sub

'------------------------------------------------- 
' 函数说明: 当使用“标签搜索”功能时，后台直接打开了某个标签的修改页，而左侧导航展开的菜单可能不在对应的“标签”下。
' 根据现有的目录结构，treeview 为“标签”栏目标记的打开cookie值为“0001”
' 根据treeview对cookie值的设定，当“标签”栏目之前的3个栏目数量有变化时，“0001”也要做对应修改。
' 详情参考 /assets/js/jquery-treeview.js 第 168 行 function serialize() 的定义。
' 注：在 modules/backend/presentation/info.asp 也对此做了设定，方便从标签详情页跳转到点击的呈现方式详情页。
'-------------------------------------------------
Sub rfOpenTreeviewTag
    Dim module
    module = Request.QueryString("module")
    Dim arrTreeview
    arrTreeview = Array("tag.essay_list", "tag.photo_list", "tag.singlepage", "tag.breadcrumb", "tag.mainnav", "tag.subnav", "tag.friendlink", "tag.partial", "tag.flexslider")
    If rfInArray(module, arrTreeview) Then
        Response.Cookies("treeview")="001"
    End If
End Sub

Sub rfShowError(source, description)
    On Error Resume Next
    rfRaiseError source, description
    %>
    <!-- #include file="../templates/frontend/error.asp" -->
    <%
    Response.End
End Sub

Sub rfShowErrorAuto(source, description)
    If ENV_DEBUG = True Then
        rfShowError source, description
    Else
        rfShow404
    End If
End Sub

Sub rfShow404
    Response.Status="404 Not Found"
    %>
    <!-- #include file="../templates/frontend/404.asp" -->
    <%
    Response.End
End Sub

Public Sub rfFinalCatchException
    If Err.Number = 0 Then
        Exit Sub
    End If
    If ENV_DEBUG = True Then
        Response.Clear '清除了之前的页面输出，只显示下面的错误页
        %>
        <!-- #include file="../templates/frontend/error.asp" -->
        <%
    Else
        rfShow404
    End If
End Sub

Sub rfRaiseError(source, description)
    Err.Raise vbObjectError + 1,  source, description
End Sub

Function rfStrLen(txt)
    Dim x, y, ii
    txt=Trim(txt)
    x = Len(txt)
    y = 0
    For ii = 1 to x
       If asc(mid(txt,ii,1))<0 Or asc(mid(txt,ii,1))>255 Then
         y = y + 2
       Else
         y = y + 1
       End If
    Next
    rfStrLen= y
End Function
Function rfStrCut(ByVal txt, length)
    Dim x, y, ii
    txt=Trim(txt)
    x = Len(txt)
    y = 0
    If x >= 1 Then
        For ii = 1 to x
            If Asc(Mid(txt,ii,1)) < 0 Or Asc(Mid(txt,ii,1)) >255 Then
                y = y + 2
            Else
                y = y + 1
            End if
            If y >= length Then
                  txt = Left(Trim(txt),ii)
               Exit For
            End If
        Next
        rfStrCut= txt
    Else
        rfStrCut= ""
    End If
End Function 
Function rfInArray(needle, haystack)
    rfInArray = False
    Dim i
    For i=0 to Ubound(haystack)
        If needle = haystack(i) Then
            rfInArray = True
            Exit For
        End If
    Next
End Function

Function rfIsEmpty(byval value)
    If IsNull(value) Or isEmpty(value) Or trim(value)="" Then 
        rfIsEmpty = True
    Else
        rfIsEmpty = False
    End If
End Function

Function rfCreateObject(objName)
    On Error Resume Next
    Dim obj, objReady, objDesription
    objReady = False
    objDesription = "-"
    Set obj = Server.CreateObject(objName)
    If Err.Number <> -2147221005 Then
        objReady = True
        objDesription = Left(obj.Version, 10)
        If rfIsEmpty(objDesription) Then
            objDesription = Left(obj.about, 10)
        Else
            objDesription = ""
        End If
    End If
    Err.Clear
    Set obj = Nothing
    rfCreateObject = Array(objReady, objDesription)
End Function

Function T(txt_key)
    If Not rfIsEmpty( Application(RF_LANGUAGE & "_" & txt_key) ) Then
        T = Application(RF_LANGUAGE & "_" & txt_key)
    Else
        Dim lang
        Set lang = new cls_language
        lang.sTxtKey = txt_key
        T = lang.getLangTxt()
        Set lang = Nothing
    End If
End Function

Function QP(sysParam)
    QP = sysParam
    If  g_action_category_map.Exists(sysParam) = True Then
        QP = g_action_category_map.Item(sysParam)
    End If
End Function

Function rfConvertStr(value)
    On Error Resume Next
    If Not isNull(value) Then
        rfConvertStr = cstr(value)
    Else
        rfConvertStr = ""
    End If
    If Err.number<>0 Then
        rfConvertStr=value
    End If
    On Error Goto 0
End Function

Function rfConvertInt(value)
    rfConvertInt = 0
    If Not isNull(value) Then
        If IsNumeric(value) And Trim(value)<>"" Then
            rfConvertInt = CInt(value)
        End If
    End If
End Function

Function rfGenerateHash()
    Dim Lenght,Index,LetterNumber,CapitalNumber,Hash
    Lenght = 0
    Randomize
    Lenght = Int(7 * Rnd)
    Lenght = Lenght + 6
    'Randomize(cint(lenght))
    For Index = 1 To cint(lenght)    
        LetterNumber = Int(25 * Rnd)
        CapitalNumber = Rnd
        If (CapitalNumber < 0.5) Then
            Hash = Hash & Chr(65 + LetterNumber)
        Else
            Hash = Hash & Chr(97 + LetterNumber)
        End If
    Next 
    rfGenerateHash = ucase(Hash)
    rfGenerateHash=left(rfGenerateHash,6)
    rfGenerateHash=left(rfGenerateHash,2)&rfConvertStr(int(rnd*10))&mid(rfGenerateHash,3,2)&rfConvertStr(int(rnd*10))&mid(rfGenerateHash,5,2)
End Function

Function rfCsrfToken
    If rfIsEmpty(Session("gCsrfToken")) Then
        Session("gCsrfToken")=rfGenerateHash
    End If
    rfCsrfToken=Session("gCsrfToken")
End Function

Function rfCsrfTokenQueryString
    rfCsrfTokenQueryString="csrfToken=" & rfCsrfToken
End Function

Function rfCsrfTokenHiddenInput
    rfCsrfTokenHiddenInput="<input type='hidden' name='csrfToken' value='" & rfCsrfToken & "' />"
End Function

Function rfCheckCsrf
    rfCheckCsrf = True 
    If RF_CSRF_CHECK = False Then
        Exit Function
    End If
    If rfConvertStr(Request("csrfToken")) <> rfConvertStr(rfCsrfToken) Then
        Session.Contents.Remove("gCsrfToken")
        rfCheckCsrf = T("rf_lang_csrf_deny")
    End If
    Session.Contents.Remove("gCsrfToken")
End Function

Function rfCheckCsrfAuto
    If RF_CSRF_CHECK = False Then
        Exit Function
    End If
    If rfConvertStr(Request("csrfToken")) <> rfConvertStr(rfCsrfToken) Then
        Session.Contents.Remove("gCsrfToken")
        rfShowErrorAuto "", T("rf_lang_csrf_deny")
    End If
    Session.Contents.Remove("gCsrfToken")
End Function

Function rfCheckCsrfByParam(value)
    rfCheckCsrfByParam = True
    If RF_CSRF_CHECK = False Then
        Exit Function
    End If
    If rfConvertStr(value) <> rfConvertStr(rfCsrfToken) Then
        Session.Contents.Remove("gCsrfToken")
        rfCheckCsrfByParam = T("rf_lang_csrf_deny")
    End If
    Session.Contents.Remove("gCsrfToken")
End Function

Function rfCheckCaptcha
    rfCheckCaptcha = True
    If LCase(rfConvertStr(Request("captcha"))) <> LCase(Session("gCaptcha")) Then
        Session.Contents.Remove("gCaptcha")
        rfCheckCaptcha = T("rf_lang_captcha_deny")
    End if
    Session.Contents.Remove("gCaptcha")
End Function
'------------------------------------------------- 
'函数说明: 两个Timer之间的毫秒差
'作用:由于是毫秒，就不带小数点了。
'-------------------------------------------------
Function rfMilliSecondDiff(timer_start, timer_end)
    rfMilliSecondDiff = 0
    If timer_start < timer_end Then
        rfMilliSecondDiff = formatnumber((timer_end - timer_start) * 1000, 0)
    End If
End Function

'------------------------------------------------- 
'函数说明: 计算代码段执行时间的埋点方法
'可嵌套使用
'-------------------------------------------------
Sub rfStartWatch
    If DEBUG_TIMEWATCHER = True Then
        g_twStack.push(timer())
    End If
End Sub
Sub rfEndWatch(eventDesc)
    If DEBUG_TIMEWATCHER = True Then
        g_timerWatcher.addWatcherItem eventDesc, rfMilliSecondDiff(g_twStack.pop(), timer())
    End If
End Sub
Sub rfEndWatchWithDB(eventDesc)
    If DEBUG_TIMEWATCHER = True Then
        Dim tmp
        tmp = rfMilliSecondDiff(g_twStack.pop(), timer())
        g_timerWatcher.addDbItem(tmp)
        g_timerWatcher.addWatcherItemDB "" & eventDesc, tmp
    End If
End Sub

' Function rfUserIP()
'     rfUserIP = Server.HTMLEncode(Server.URLEncode(Request.ServerVariables ( "HTTP_X_FORWARDED_FOR" )))
'     If rfUserIP = "" Then
'     rfUserIP = Request.ServerVariables ( "REMOTE_ADDR" )
'     End if
' End Function
'------------------------------------------------- 
'函数说明: 获取用户IP
' 摘自dvbbs，注释了actforip。actforip是用户代理IP。
' 动网的考虑是：“禁止代理服务器访问能避免恶意的CC攻击，但开放后影响站点排名，建议在受到明显的攻击的时候开启”
'-------------------------------------------------
Function rfUserIP()
    Dim strIPAddr
    ' Dim actforip
    If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then 
        strIPAddr = Request.ServerVariables("REMOTE_ADDR") 
    ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then 
        strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1) 
        ' actforip=Request.ServerVariables("REMOTE_ADDR")
    Else 
        strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR") 
        ' actforip=Request.ServerVariables("REMOTE_ADDR")
    End If 
    rfUserIP = Trim(Mid(strIPAddr, 1, 30))
End Function 

Function rfHtmlEncode(reString) '转换HTML代码
    Dim Str:Str=reString
    IF Not isnull(Str) Then
        Str = replace(Str, ">", "&gt;")
        Str = replace(Str, "<", "&lt;")
        Str = Replace(Str, CHR(32), "&nbsp;")
        Str = Replace(Str, CHR(9), "&nbsp;")
        Str = Replace(Str, CHR(34), "&quot;")
        Str = Replace(Str, CHR(39), "&#39;")
        Str = Replace(Str, CHR(13), "")
        Str = Replace(Str, CHR(10), "<br>")
        Str = Replace(Str, CHR(92), "&#92;")
        rfHtmlEncode = Str
    End IF
End Function

Function rfReplace(haystack, find, replacewith)
    rfReplace = replace(haystack, find, replacewith, 1,-1, 1) 
End Function

Function rfReplaceRegex(haystack, pattern, replacewith)
    ' 如果 haystack 为 null（注意不是 ""）时，会出现如下提示：
    ' Microsoft VBScript 运行时错误 错误 '800a000d'
    ' 类型不匹配: 'regEx.Replace'
    ' 因为 rfExtractFirstSubMatch 函数不匹配时返回 null 造成的。尽管已经将该函数的 null 改为了 ""，还是保留此处的判断。
    haystack = rfConvertStr(haystack)
    replacewith = rfConvertStr(replacewith)
    If rfIsEmpty(haystack) Then
        rfReplaceRegex = ""
        Exit Function
    End If
    Dim regEx
    Set regEx = New RegExp
    regEx.Pattern = pattern
    regEx.IgnoreCase = True ' 忽略大小写。
    regEx.Global = True ' 设置全程可用性
    rfReplaceRegex = regEx.Replace(haystack, replacewith) 
    Set regEx = Nothing
End Function

Function rfRegexTest(haystack, pattern)
    Dim regEx
    Set regEx = New RegExp
    regEx.Pattern = pattern
    regEx.IgnoreCase = True ' 忽略大小写。
    regEx.Global = True ' 设置全程可用性
    rfRegexTest = regEx.Test(haystack) 
    Set regEx = Nothing
End Function

Function rfExtractFirstSubMatch(str, pattern)
    rfExtractFirstSubMatch = ""
    Dim regEx, matches, match
    Set regEx = New RegExp
    regEx.Pattern = pattern
    regEx.IgnoreCase = True
    regEx.Global = False '只考虑带有1次的情况
    Set matches = regEx.Execute(str) 
    For Each match in matches
        rfExtractFirstSubMatch = match.SubMatches(0)
        Exit For
    Next 
    Set Matches = Nothing
    Set regEx = Nothing
End Function

Function rfCleanInput(str)
    Dim pattern:pattern="'|\b(alert|confirm|prompt)\b|<[^>]*?>|^\+/v(8|9)|\bonmouse(over|move)=\b|\b(and|or)\b.+?(>|<|=|\bin\b|\blike\b)|/\*.+?\*/|<\s*script\b|\bEXEC\b|UNION.+?SELECT|UPDATE.+?SET|INSERT\s+INTO.+?VALUES|(SELECT|DELETE).+?FROM|(CREATE|ALTER|DROP|TRUNCATE)\s+(TABLE|DATABASE)|xp_cmdshell|net|char|count|mid|declare|master|exec|%"
    rfCleanInput = rfReplaceRegex(str, pattern, "")
End Function

Function rfCleanSingleQuotation(str)
    rfCleanSingleQuotation = rfReplace(str,"'","''")
End Function

Function fmtUserRole(roleType)
    Select Case roleType
        Case 1
            fmtUserRole = T("rf_lang_user_role_admin")
        Case 2
            fmtUserRole = T("rf_lang_user_role_editor")
        Case Else
            fmtUserRole = T("rf_lang_unknow")
    End Select
End Function
Function fmtUserStatus(statusType)
    Select Case statusType
        Case 1
            fmtUserStatus = T("rf_lang_user_status_normal")
        Case 2 
            fmtUserStatus = T("rf_lang_user_status_forbidden")
        Case 3
            fmtUserStatus = T("rf_lang_user_status_deleted")
        Case Else
            fmtUserStatus = T("rf_lang_unknow")
    End Select
End Function
Function fmtCategoryType(catType)
    Select Case catType
        Case 1
            fmtCategoryType = T("rf_lang_datasource_category_essays")
        Case 2
            fmtCategoryType = T("rf_lang_datasource_category_photos")
        Case 3
            fmtCategoryType = T("rf_lang_datasource_category_friendlinks")
        Case 4
            fmtCategoryType = T("rf_lang_datasource_category_singlepage")
        Case Else
            fmtCategoryType = T("rf_lang_unknow")
    End Select
End Function

Function fmtCategoryIcon(catType)
    Select Case catType
        Case 1
            fmtCategoryIcon = "list"
        Case 2
            fmtCategoryIcon = "picture"
        Case 3
            fmtCategoryIcon = "link"
        Case 4
            fmtCategoryIcon = "file"
        Case Else
            fmtCategoryIcon = "minus"
    End Select
    fmtCategoryIcon = "<span class=""glyphicon glyphicon-"&fmtCategoryIcon&""" aria-hidden=""true""></span>"
End Function


Function fmtFriendlinkFontcolor(val)
    Select Case val
        Case 1
            fmtFriendlinkFontcolor = T("rf_lang_friendlink_fontcolor_default")
        Case 2
            fmtFriendlinkFontcolor = T("rf_lang_friendlink_fontcolor_red")
        Case 3
            fmtFriendlinkFontcolor = T("rf_lang_friendlink_fontcolor_blue")
        Case 4
            fmtFriendlinkFontcolor = T("rf_lang_friendlink_fontcolor_grey")
        Case Else
            fmtFriendlinkFontcolor = T("rf_lang_unknow")
    End Select
End Function
Function fmtFriendlinkFontcolorText(flag, linkname)
    Select Case flag
        Case 2
            fmtFriendlinkFontcolorText = "<span style=""color: #c00;"">" & linkname & "</span>"
        Case 3
            fmtFriendlinkFontcolorText = "<span style=""color: #0000ff;"">" & linkname & "</span>"
        Case 4
            fmtFriendlinkFontcolorText = "<span style=""color: #777;"">" & linkname & "</span>"
        Case Else
            fmtFriendlinkFontcolorText = linkname
    End Select
End Function

Function fmtPaginationAbsolutePage(pageInUrl, pageCountInADO)
    If pageInUrl < 1  Then
        fmtPaginationAbsolutePage = 1
    ElseIf pageInUrl >= pageCountInADO Then
        fmtPaginationAbsolutePage = pageCountInADO
    Else
        fmtPaginationAbsolutePage = pageInUrl
    End If
End Function

Function fmtPresentationOfficial(val)
    Select Case val
        Case 1
            fmtPresentationOfficial = T("rf_lang_official")
        Case 2
            fmtPresentationOfficial = T("rf_lang_no_official")
        Case Else
            fmtPresentationOfficial = T("rf_lang_unknow")
    End Select
End Function

Function fmtPresentationType(val)
    Select Case val
        Case 1
            fmtPresentationType = T("rf_lang_presentation_pretype_essay_list")
        Case 2
            fmtPresentationType = T("rf_lang_presentation_pretype_essay_info")
        Case 3
            fmtPresentationType = T("rf_lang_presentation_pretype_photo_list")
        Case 4
            fmtPresentationType = T("rf_lang_presentation_pretype_photo_info")
        Case 5
            fmtPresentationType = T("rf_lang_presentation_pretype_singlepage")
        Case 6
            fmtPresentationType = T("rf_lang_presentation_pretype_breadcrumb")
        Case 7
            fmtPresentationType = T("rf_lang_presentation_pretype_mainnav")
        Case 8
            fmtPresentationType = T("rf_lang_presentation_pretype_subnav")
        Case 9
            fmtPresentationType = T("rf_lang_presentation_pretype_friendlink")
        Case 10
            fmtPresentationType = T("rf_lang_partial")
        Case 11
            fmtPresentationType = T("rf_lang_presentation_pretype_photo_flexslider")
        Case Else
            fmtPresentationType = T("rf_lang_unknow")
    End Select
End Function

Function rfTagType2Module(tagtype)
    Select Case tagtype
        Case 1
            rfTagType2Module = "tag.essay_list"
        Case 3
            rfTagType2Module = "tag.photo_list"
        Case 5
            rfTagType2Module = "tag.singlepage"
        Case 6
            rfTagType2Module = "tag.breadcrumb"
        Case 7
            rfTagType2Module = "tag.mainnav"
        Case 8
            rfTagType2Module = "tag.subnav"
        Case 9
            rfTagType2Module = "tag.friendlink"
        Case 10
            rfTagType2Module = "tag.partial"
        Case 11
            rfTagType2Module = "tag.flexslider"
        Case Else
            rfTagType2Module = False
    End Select
End Function

Function fmtMenuType(val)
    Select Case val
        Case 1
            fmtMenuType = T("rf_lang_menu_type_func")
        Case 2
            fmtMenuType = T("rf_lang_menu_type_channel")
        Case Else
            fmtMenuType = T("rf_lang_unknow")
    End Select
End Function

Function rfWrapHtmlComment(str)
    rfWrapHtmlComment = vbNewLine & str & "<!-- " & str & "-->" & vbNewLine
End Function

Function rfListTagPagerPattern
    rfListTagPagerPattern = "^.*?\|Pager$"
End Function

Function rfCommonTagPattern
    rfCommonTagPattern = "\{\{refinecms\}\}"
End Function

Function rfCommonTag
    rfCommonTag = "{{refinecms}}"
End Function

Function rfPhotoAutoScale(fitWidth, fitHeight, resolution)
    Dim hhRtn, wwRtn, ww, hh, arr
    hhRtn=0
    wwRtn=0
    If rfIsEmpty(resolution) Then
        rfPhotoAutoScale = ""
        Exit Function
    End If
    arr = Split(resolution, "x", -1, 1)
    ww = arr(0)
    hh = arr(1)

    If ww>0 And hh>0 Then
        If ww/hh>=fitWidth/fitHeight Then
            wwRtn=fitWidth
            hhRtn=CInt((hh*fitWidth)/ww)
        Else
            hhRtn=fitHeight
            wwRtn=CInt((ww*fitHeight)/hh)
        End If
    End If
    rfPhotoAutoScale=" width='"&wwRtn&"'"&" height='"&hhRtn&"' "
End Function

'------------------------------------------------- 
' 函数说明: 将日期字符串，按照自定义格式输出
' formatStr 的值包括了：
' y     : 年
' m    : 月
' d     : 日
' h     : 小时数
' i      : 分钟数
' s     : 秒数
' 比如： y-m-d h:i:s 输出 2018-02-24 04:36:55
'-------------------------------------------------
Function rfFormatDate(dateStr, formatStr)
    If isDate(dateStr) Then
        Dim dt
        dt = CDate(dateStr)
        rfFormatDate = formatStr
        rfFormatDate = rfReplace(rfFormatDate, "y", CStr(Year(dt)))
        rfFormatDate = rfReplace(rfFormatDate, "m", Right("0"&CStr(Month(dt)), 2) )
        rfFormatDate = rfReplace(rfFormatDate, "d", Right("0"&CStr(Day(dt)), 2) )
        rfFormatDate = rfReplace(rfFormatDate, "h", Right("0"&CStr(Hour(dt)), 2) )
        rfFormatDate = rfReplace(rfFormatDate, "i", Right("0"&CStr(Minute(dt)), 2) )
        rfFormatDate = rfReplace(rfFormatDate, "s", Right("0"&CStr(Second(dt)), 2) )
    Else
        rfFormatDate = dateStr
    End If
End Function

'------------------------------------------------- 
' 函数说明: 从标签使用的变量中提取修饰器、及其参数
' 啰嗦之处在于处理双引号里面的冒号
' 传入值str:      |date_format:"ymd h:i:s":"d:h":4:"d:d":6:7:"good"
' 返回值： Array("data_format", "ymd h:i:s", "d:h", 4, "d:d", 6, 7, "good")
'-------------------------------------------------
Function rfExplodeModifier(str)
    Dim strlen, i, startPos, inQuotationArea, result
    result = ""
    If Len(str)>2 Then
        str = Mid(str, 2, Len(str)-1)
    End If
    strlen = Len(str)
    startPos = 1
    inQuotationArea = False
    For i=1 to strlen
        If Mid(str, i, 1)  = ":" Then
            If Not inQuotationArea Then
                If result = "" Then
                    result = Trim(Mid(str, startPos, i-startPos))
                Else
                    result = result & "@" & Trim(Mid(str, startPos, i-startPos))
                End If
                startPos = i + 1
            End If
        ElseIf Mid(str, i, 1)  = """" Then
            inQuotationArea = Not inQuotationArea
        End If
        If i = strlen And Mid(str, i, 1)  <> ":" Then
            If result = "" Then
                result = Trim(Mid(str, startPos, i-startPos+1))
            Else
                result = result & "@" & Trim(Mid(str, startPos, i-startPos+1))
            End If
        End If
    Next
    result = rfReplace(result, """", "")
    rfExplodeModifier = Split(result, "@", -1, 1)
End Function

Function rfIndexUrl
    rfIndexUrl = RF_SITE_URL_PRE  &  Request.ServerVariables("HTTP_HOST") &  Request.ServerVariables("PATH_INFO")
    rfIndexUrl = rfReplaceRegex(rfIndexUrl, "default.asp|index.asp", "")
End Function

Function rfCurrentUrl
    rfCurrentUrl = RF_SITE_URL_PRE  &  Request.ServerVariables("HTTP_HOST") &  Request.ServerVariables("PATH_INFO")
    If Not rfIsEmpty(Request.ServerVariables("QUERY_STRING")) Then
        rfCurrentUrl = rfCurrentUrl & "?" & Request.ServerVariables("QUERY_STRING")
    End If
    rfCurrentUrl = rfReplaceRegex(rfCurrentUrl, "default.asp|index.asp", "")
End Function


Function rfCreateFolder(folderStr)
    Dim fs
    Set fs = Server.CreateObject("Scripting.FileSystemObject")
    Dim arr, i, folder
    folder = ""
    arr =Split(folderStr, "/", -1, 1)
    For i=0 to UBound(arr)
        If Not rfIsEmpty(arr(i)) Then
            folder = folder & "/" & arr(i)
            If Not fs.FolderExists(Server.MapPath(folder))  Then
                fs.CreateFolder(Server.MapPath(folder))
            End If
        End If
    Next
    Set fs = Nothing
End Function

Sub rfRemoveFile(path)
    If rfIsEmpty(path) Then
        Exit Sub
    End If
    Dim fs
    Set fs = Server.CreateObject("Scripting.FileSystemObject")
    If fs.FileExists(Server.MapPath(path)) Then
        fs.DeleteFile(Server.MapPath(path))
    End If
    Set fs = Nothing
End Sub

Sub rfRenameFile(pathFrom, pathTo)
    If rfIsEmpty(pathFrom) Then
        Exit Sub
    End If
    Dim fs
    Set fs = Server.CreateObject("Scripting.FileSystemObject")
    If fs.FileExists(Server.MapPath(pathFrom)) Then
        fs.MoveFile Server.MapPath(pathFrom), Server.MapPath(pathTo)
    End If
    Set fs = Nothing
End Sub

Function rfFileExists(path)
    rfFileExists = False
    Dim fs
    Set fs = Server.CreateObject("Scripting.FileSystemObject")
    If fs.FileExists(Server.MapPath(path)) Then
        rfFileExists = True
    End If
    Set fs = Nothing
End Function

Sub rfPageCacheGet
    If RF_PAGE_CACHE Then
        Dim urlKey, cacheLoad
        urlKey = RF_PAGE_CACHE_PREFIX & SHA256(rfCurrentUrl)
        If Not rfIsEmpty(Application(urlKey)) Then
            rfEndWatch("页面载入总耗时")
            cacheLoad = "<!--  开启缓存后，页面打开耗时: " & vbNewLine
            cacheLoad = cacheLoad & g_timerWatcher.showSimpleInfo & vbNewLine
            cacheLoad = cacheLoad & " -->" & vbNewLine
            g_timerWatcher.clearLastLog
            rfExit cacheLoad & Application(urlKey)
        End If
    End If
End Sub

Sub rfPageCacheSet(html)
    If RF_PAGE_CACHE Then
        Dim urlKey, pageInfo
        urlKey = RF_PAGE_CACHE_PREFIX & SHA256(rfCurrentUrl)
        pageInfo = "<!--  来自于 RefineCMS 的缓存: " & vbNewLine
        pageInfo = pageInfo & "键值为：" & urlKey & vbNewLine
        pageInfo = pageInfo & "缓存生成时间：" & Now() & vbNewLine
        pageInfo = pageInfo & " -->" & vbNewLine
        Application(urlKey) = pageInfo & html
    End If
End Sub

Function rfCustomTplCheck(filename)
    rfCustomTplCheck =  False
    Dim targetID
    targetID = rfExtractFirstSubMatch(filename, "info_(\d+)\.asp")
    If Not rfIsEmpty(targetID) Then
        Dim tag
        Set tag = new cls_Tag
        tag.init targetID
        If tag.iID > 0 And tag.iInfotplFlag = 2 Then
            rfCustomTplCheck = True
            Set tag = Nothing
            Exit Function
        End If
        Set tag = Nothing
    End If

    targetID = rfExtractFirstSubMatch(filename, "menu_(\d+)\.asp")
    If Not rfIsEmpty(targetID) Then
        Dim menu
        Set menu = new cls_Menu
        menu.init targetID
        If menu.iID > 0 And menu.iMenuType = 2 Then
            rfCustomTplCheck = True
            Set menu = Nothing
            Exit Function
        End If
        Set menu = Nothing
    End If
End Function

Function fmtTipsStatus(val)
    If val = True Then
        fmtTipsStatus = T("rf_lang_status_success")
    Else 
        fmtTipsStatus = T("rf_lang_status_fail")
    End If
End Function
%>